home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
graphic
/
tpega.zip
/
CIRCLE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-02-01
|
2KB
|
80 lines
{ }
{ EGA Graphic Primitive for Turbo Pascal 3.01A, Version 01FEB86. }
{ (C) 1986 by Kent Cedola, 2015 Meadow Lake Ct., Norfolk, VA, 23518 }
{ }
{ Please note the current version is in assembler, the below is the }
{ algorithm used for the high-speed assembler version. Long integers }
{ are used instead of real number. (DX:AX). }
{ }
{ See Dr. Dobbs Journal, December 1983, pp. 18. for BASIC source code. }
{ }
procedure GPCIR(R: Integer); { Same format for final version }
var
BE,XD,YD,DX,DY,ER,TX,TY,TB: Real;
AE,YC,XF1,XF2,YF,X,Y: Integer;
begin
X := GDCUR_X;
Y := GDCUR_Y;
AE := R;
BE := R * GDASPC1 div GDASPC2;
YC := GDCUR_Y;
XF1 := GDCUR_X;
XF2 := GDCUR_X;
YF := Round(BE);
XD := BE * BE;
YD := (2 * BE - 1) * AE * AE;
DX := 2 * BE * BE;
DY := 2 * AE * AE;
ER := 0;
GPPLOT(XF1,YC+YF); { GPPLOT does the clipping for us }
GPPLOT(XF1,YC-YF);
GPPLOT(XF2,YC+YF);
GPPLOT(XF2,YC-YF);
repeat
TX := ER + XD;
TY := ER - YD;
TB := ER + XD - YD;
if (abs(TX) < abs(TY)) and (abs(TX) < abs(TB)) then
begin
XF1 := XF1 + 1;
XF2 := XF2 - 1;
ER := TX;
XD := XD + DX;
end
else if (abs(TY) < abs(TX)) and (abs(TY) < abs(TB)) then
begin
YF := YF - 1;
ER := TY;
YD := YD - DY;
end
else
begin
XF1 := XF1 + 1;
XF2 := XF2 - 1;
YF := YF - 1;
ER := TB;
YD := YD - DY;
XD := XD + DX;
end;
GPPLOT(XF1,YC+YF);
GPPLOT(XF1,YC-YF);
GPPLOT(XF2,YC+YF);
GPPLOT(XF2,YC-YF);
until YF = 0;
GDCUR_X := X;
GDCUR_Y := Y;
end;